home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpsqapi1.zip / MSGTOSQ.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-13  |  5KB  |  193 lines
  1. {$A-,R-,O+}
  2.  
  3. unit MSGToSq;
  4.  
  5. (*
  6.      This unit will take a SDM message and rearrange it, and store it
  7.      in a SQUISH FILE.
  8. *)
  9.  
  10. interface
  11.  
  12. uses
  13.  
  14.    Squish,
  15.    fidofmt;
  16.  
  17. function SDMToSQD(
  18.                    mname,
  19.                    sname: String;
  20.                    var mh : _fidoMsgType;
  21.                    var newnum : word;
  22.                    lockit : boolean
  23.                  ): Integer;
  24.  
  25. procedure ArrangeTxt(var msg: MsgBufPtrType; var msiz, csiz: LongInt);
  26.  
  27. implementation
  28.  
  29. (*
  30.  
  31. Function, given ptr to buffer and size , will arrange the control info
  32. and message test, and return the new sizes for both sections
  33.  
  34. *)
  35.  
  36. procedure ArrangeTxt(var msg: MsgBufPtrType; var msiz, csiz: LongInt);
  37. var
  38.    mpos,
  39.    cpos: Word;
  40.    tsize : word;
  41.  begin
  42.    mpos := 0;
  43.    cpos := 0;
  44.    tsize := msiz;
  45.  
  46.    while (msg^[mpos] = #10) do Inc(mpos);
  47.  
  48.    while (msg^[mpos] = #1) do
  49.       begin
  50.          if (mpos > cpos) then
  51.            begin
  52.             Move(msg^[mpos],msg^[cpos],msiz - mpos);
  53.             Dec(msiz,mpos - cpos);
  54.             cpos := mpos
  55.            end;
  56.          while (not (msg^[cpos] in [#0,#13])) do Inc(cpos);
  57.          if (msg^[cpos] = #13) then
  58.             begin
  59.               msg^[cpos] := #0;
  60.               mpos := cpos + 1;
  61.               while (msg^[mpos] = #10) do Inc(mpos)
  62.             end
  63.          else mpos := cpos
  64.       end;
  65.  
  66.    if (msg^[msiz] <> #0) then msg^[msiz] := #0;
  67.  
  68.    csiz := 0;
  69.    if (msg^[0] = #1) then
  70.       begin
  71.         while (msg^[csiz] <> #0) do Inc(csiz);
  72.         Inc(csiz)
  73.       end;
  74.    if (csiz = 0) then
  75.      begin
  76.       Move(msg^[csiz],msg^[csiz+1],msiz);
  77.       Inc(msiz);
  78.       msg^[0] := #0;
  79.       csiz := 1
  80.      end
  81.  end;
  82.  
  83.  
  84. (* Convert "*.MSG" header to Squish message header *)
  85.  
  86. procedure SdmToSqMHdr(var mh: _fidomsgtype; var sh: _SqMHdrtype);
  87. begin
  88.    FillChar(sh,SizeOf(_SqMHdrtype),#0);
  89.    Move(mh.towhom,   sh.towhom, 36);
  90.    Move(mh.from,     sh.fromwhom,36);
  91.    Move(mh.subject,  sh.subj,72);
  92.    Move(mh.azdate,   sh.azdate,20);
  93.    sh.orig.zone    := 0;
  94.    sh.dest.zone    := 0;
  95.    sh.orig.net     := mh.orig_net;
  96.    sh.dest.net     := mh.dest_net;
  97.    sh.orig.node    := mh.orig_node;
  98.    sh.dest.node    := mh.dest_node;
  99.    sh.attr         := mh.attr;
  100.    sh.date_written := mh.date_written;
  101.    sh.date_arrived := mh.date_arrived;
  102.    sh.replyto      := mh.reply
  103. end;
  104.  
  105.  
  106. function SDMToSQD(
  107.                    mname,
  108.                    sname: String;
  109.                    var mh : _fidoMsgType;
  110.                    var newnum : word;
  111.                    lockit     : boolean
  112.                  ): Integer;
  113. var
  114.    mb: MsgBufPtrType;
  115.    fo,
  116.    fz,
  117.    mz,
  118.    cz: LongInt;
  119.    sb: _SqBasetype;
  120.    sf: _SqFHdrType;
  121.    sm: _SqMHdrType;
  122.    si: _SqIdxType;
  123.    rc: Integer;
  124.    fi,
  125.    fd: File;
  126.    msize : longint;
  127. begin
  128.  
  129.    rc := SDMRead(mname,mh,mb,msize);
  130.    if (rc = 0) then
  131.    begin
  132.       mz := msize;
  133.       ArrangeTxt(mb,mz,cz);
  134.       Inc(mz,_SQMSIZE);
  135.       rc := SqOpenSQD(sname,fd,Lockit);
  136.       if (rc = 0) then
  137.       begin
  138.          rc := SqReadBHdr(fd,sb);
  139.          if (rc = 0) then
  140.          begin
  141.             fz := mz;
  142.             rc := SqNewFrame(fd,sb,sf,fz,fo);
  143.             if (rc = 0) then
  144.             begin
  145.                sf.frame_length := fz;
  146.                sf.msg_length   := mz;
  147.                sf.clen         := cz;
  148.                if (sf.frame_length = 0) then
  149.                begin
  150.                   sf.frame_length := sf.msg_length;
  151.                   sb.end_frame := fo + _SQFSIZE + _SQMSIZE + sf.frame_length
  152.                end;
  153.                rc := SqWriteFHdr(fd,sf,fo);
  154.                if (rc = 0) then
  155.                begin
  156.                   SDMToSqMHdr(mh,sm);
  157.                   rc := SqWriteMHdr(fd,sm,fo);
  158.                   if (rc = 0) then
  159.                   begin
  160.                      rc := SqWriteMTxt(fd,mb^,fo,mz);
  161.                      if (rc = 0) then
  162.                      begin
  163.                         si.ofs    := fo;
  164.                         si.umsgid := sb.uid;
  165.                         si.hash   := SqAzHashName(sm.towhom);
  166.                         Inc(sb.num_msg);
  167.                         sb.high_msg := sb.num_msg;
  168.                         Inc(sb.uid);
  169.                         rc := SqWriteBHdr(fd,sb);
  170.                         if (rc = 0) then
  171.                         begin
  172.                            rc := SqOpenSQI(sname,fi);
  173.                            if (rc = 0) then
  174.                            begin
  175.                               rc := SqWriteSqI(fi,si,sb.num_msg-1);
  176.                               rc := SqCloseSQI(fi);
  177.                               newnum := sb.num_msg;
  178.                            end
  179.                         end
  180.                      end
  181.                   end
  182.                end
  183.             end
  184.          end;
  185.          rc := SqCloseSQD(fd)
  186.       end
  187.    end;
  188.    if mb <> nil then FreeMem(mb,msize);
  189.    SDMToSQD := rc
  190. end;
  191.  
  192. end.
  193.